(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ") T) (LISPXPRIN1 (QUOTE 
"11-APR-73 23:07:42") T) (LISPXTERPRI T))
(LISPXPRINT (QUOTE EDITSTRUCVARS) T)
(RPAQQ EDITSTRUCVARS ((P (PROGN (LISPXPRIN1 (QUOTE 
"*** TYPE HELP-EDIT<CAR RET> FOR HELP") T) (LISPXTERPRI T))) (RECORD
MARKER-REC) (PROP RECDEFAULT MARKERS) (P (RPAQ EDITSTRUCTURE NIL))
(VARS EDITSTRUCCOMMANDS KNOWNSUPERATOMS DOTNOTATION EDITSTRUCMACROS
MATCHNUM STRUCTURE) (FNS ADDCOMMAND ADDDOTS ADDFV BONDEDP BONDORDER
BREAKUP CHAIN COMPOSE4 CYCLE DELETESUPERATOM DOTS HELP-EDIT JOIN 
MERGESTRUCS NAME NEWSTRUCTURE P PUTNEWNODE RECOGNIZEFN RECOGNIZEFN*
REMOVEDOTS SATURATE SHOWIT UNSATURATE) (PROP RECDEFAULT DOTSFIELD)
(P (/NCONC LISPXMACROS EDITSTRUCMACROS)) (P (/NCONC LISPXMACROS (MAPCAR
KNOWNSUPERATOMS (FUNCTION RECOGNIZEFN))))))
(PROGN (LISPXPRIN1 (QUOTE "*** TYPE HELP-EDIT<CAR RET> FOR HELP")
T) (LISPXTERPRI T))
(DEFLIST(QUOTE(
(MARKER-REC (ATOMTYPE DOTSFIELD . OTHERMARKERS))
))(QUOTE RECORD))

(RECORD (QUOTE MARKER-REC))
(DEFLIST(QUOTE(
(MARKERS (NIL (DOT . 0)))
))(QUOTE RECDEFAULT))

(RPAQ EDITSTRUCTURE NIL)
(RPAQQ EDITSTRUCCOMMANDS (HELP-EDIT ADDFV HELLO NAMEIT P CYCLE CHAIN
SHOWIT JOIN NEW))
(RPAQQ KNOWNSUPERATOMS NIL)
(RPAQQ DOTNOTATION NIL)
(RPAQQ EDITSTRUCMACROS ((HELP-EDIT (PROG2 (APPLY (QUOTE HELP-EDIT)
LISPXLINE) (QUOTE DONE))) (ADDFV (PROG2 (APPLY (QUOTE ADDFV) (LIST
LISPXLINE)) (QUOTE DONE))) (P (PROG2 (APPLY (QUOTE P) LISPXLINE) (QUOTE
DONE))) (NAMEIT (PROG2 (APPLY (QUOTE NAME) LISPXLINE) (QUOTE DONE)))
(CYCLE (PROG2 (APPLY (QUOTE CYCLE) LISPXLINE) (QUOTE DONE))) (CHAIN
(PROG2 (APPLY (QUOTE CHAIN) LISPXLINE) (QUOTE DONE))) (SHOWIT (PROG2
(APPLY (QUOTE SHOWIT) LISPXLINE) (QUOTE DONE))) (JOIN (PROG2 (APPLY
(QUOTE JOIN) LISPXLINE) (QUOTE DONE))) (NEW (NEWSTRUCTURE)) (JAN2
(RECOGNIZEFN JAN2)) (JAN5 (RECOGNIZEFN JAN5)) (JAN10 (RECOGNIZEFN
JAN10)) (SRI9 (RECOGNIZEFN SRI9)) (SRI12 (RECOGNIZEFN SRI12)) (
ADAMANTINE (RECOGNIZEFN ADAMANTINE)) (PENTANE (RECOGNIZEFN PENTANE))
(PENTANE (RECOGNIZEFN PENTANE)) (PENTANE (RECOGNIZEFN PENTANE))))
(RPAQQ MATCHNUM 0)
(RPAQQ STRUCTURE ((CTENTRY 6 (C (DOT . 0)) 3 2 1 5) (CTENTRY 5 (C
(DOT . 0)) 3 4 6 4) (CTENTRY 4 (C (DOT . 0)) 1 5 5 3) (CTENTRY 3 (C
(DOT . 0)) 6 5 4 2) (CTENTRY 2 (C (DOT . 0)) 6 1 3 1) (CTENTRY 1 (C
(DOT . 0)) 4 6 2 2)))
(DEFINEQ

(ADDCOMMAND
(LAMBDA (X) (SETQ EDITSTRUCCOMMANDS (CONS X EDITSTRUCCOMMANDS)) (SETQ
X (LIST X (LIST (QUOTE PROG2) (LIST (QUOTE APPLY) (KWOTE X) (QUOTE
LISPXLINE)) (KWOTE (QUOTE DONE))))) (SETQ EDITSTRUCMACROS (CONS X
EDITSTRUCMACROS)) (SETQ LISPXMACROS (CONS X LISPXMACROS)) "ADDED"))

(ADDDOTS
(LAMBDA (NODE NUMBER STRUC) (PROG (M) (SETQ M (DOTSFIELD (MARKERS
(FINDCTE NODE (OR STRUC EDITSTRUCTURE))))) (RPLACD M (PLUS (OR NUMBER
1) (OR (CDR M) 0))))))

(ADDFV
(LAMBDA (LL STRUC) (SETQ STRUC (OR STRUC EDITSTRUCTURE)) (FOR NEW
L IN LL DO (/RPLACD (CDR (CDR (FINDCTE L STRUC))) (/NCONC1 (NBRS (
FINDCTE L STRUC)) (QUOTE FV)))) (QUOTE DONE)))

(BONDEDP
(LAMBDA (N1 N2 STRUC) (MEMBER N2 (NBRS (FINDCTE N1 (OR STRUC 
EDITSTRUCTURE))))))

(BONDORDER
(LAMBDA (C1 C2) (PLUS (CONNECTIVITY (NODENUM C1) (NODENUM C2) 
EDITSTRUCTURE) (TIMES .5 (PLUS (DOTS (NODENUM C1)) (DOTS (NODENUM
C2)))))))

(BREAKUP
(LAMBDA (STRING) (PROG (ATOMS BONDLIST (N LASTNODE)) (FOR NEW X IN
(UNPACK STRING) DO (IF (NUMBERP X) THEN (SETQ BONDLIST (APPEND (FOR
NEW I := (2 X) XLIST (CONS N (ADD1 N))) BONDLIST)) ELSE (SETQ N (ADD1
N)) (SETQ ATOMS (CONS X ATOMS)))) (RETURN (CONS (DREVERSE ATOMS) 
BONDLIST)))))

(CHAIN
(LAMBDA (ARG) (PROG (STRUC LN) (SETQ LN (ADD1 LASTNODE)) (IF (NUMBERP
ARG) THEN (SETQ ARG (PACK (FOR I := (1 ARG) XLIST 'C)))) (IF (ATOM
ARG) THEN (PROG (A) (SETQ A (BREAKUP ARG)) (SETQ STRUC (BIVCHAIN (LENGTH
(CAR A)))) (FOR NEW X IN (CDR A) DO (UNSATURATE (CAR X) (CDR X) STRUC))
(FOR NEW CT IN (CTABLE OF STRUC) AS NEW ATOMNAME IN (DREVERSE (CAR
A)) DO (REPLACE (ATOMTYPE (MARKERS CT)) ATOMNAME)))) (IF (EQP LN 
LASTNODE) THEN (MAPRINT (LIST (QUOTE NODE) LN)) ELSE (MAPRINT (LIST
(QUOTE NODES) LN (QUOTE TO) LASTNODE))) (TERPRI) (/RPLACA (QUOTE 
EDITSTRUCTURE) (MERGESTRUCS STRUC)) (RETURN EDITSTRUCTURE))))

(COMPOSE4
(LAMBDA (FIELD) (COND ((NULL FIELD) NIL) ((ATOM FIELD) ((LAMBDA (X)
(COND (X (KWOTE X)))) (COPY (GETP FIELD (QUOTE RECDEFAULT))))) (T
(≠CONS (COMPOSE4 (CAR FIELD)) (COMPOSE4 (CDR FIELD)))))))

(CYCLE
(LAMBDA (ARG) (PROG (STRUC LN) (SETQ LN (ADD1 LASTNODE)) (SETQ STRUC
(CHAIN ARG)) (CONNECT (FINDCTE LN STRUC) (FINDCTE LASTNODE STRUC))
(RETURN STRUC))))

(DELETESUPERATOM
(LAMBDA (SUPAT) (SETQ KNOWNSUPERATOMS (DELETE SUPAT KNOWNSUPERATOMS))
(SETQ LISPXMACROS (FOR NEW M IN LISPXMACROS WHEN (NOT (EQ (CAR M)
SUPAT)) XLIST M)) (MAPCAR LISPXMACROS (QUOTE CAR))))

(DOTS
(LAMBDA (A) (* Gives the number of DOTS (OR EQUIVALENT THEREOF) of
A node of the BIGGRAPH) (COND (DOTNOTATION (ERROR "NOT IMPLEMENTED YET"))
(T (FOR A ON A WHEN (AND (NOT (EQ (CAR A) (QUOTE FV))) (MEMBER (CAR
A) (CDR A))) PLUS 1)))))

(HELP-EDIT
(LAMBDA (ARG) (IF (NOT ARG) THEN (TERPRI) (COND ((EQ (QUOTE YES) (RP
"HAVE YOU NEVER USED THE SYSTEM")) (PRINT 
"PLEASE TALK TO SRIDHARAN FOR PRELIMINARY INFORMATION") (MAPRINT (QUOTE
(THIS SYSTEM HELPS ONE TO USE THE COMPUTER ESSENTIALLY AS ONE'S BALL
AND STICK CHEMISTRY KIT ;))) (TERPRI) (MAPRINT (QUOTE (HOWEVER, THE
STICKS ARE MORE LIKE RUBBER BANDS FOR THE STRUCTURES ONE CREATES USING
THIS SYSTEM ARE TOPOLOGICAL IN CHARACTER RATHER THAN BEING GEOMETRICAL)))
(TERPRI) (MAPRINT (QUOTE (THERE ARE SIMPLE COMMANDS TO CREATE, CHANGE
AND SAVE STRUCTURES;))) (TERPRI) (PRINT 
"**** DO NOT HESITATE TO TRY ALL COMMANDS JUST 
     FOR FUN -- IF YOU DO NOT LIKE WHAT HAPPENS FREELY USE THE COMMAND
     'UNDO'.  AND HAVE FUN!"))) (PRINT 
"TO GET HELP ON ANY ONE COMMAND YOU MAY SUPPLY AN ARGUMENT
TO THE HELP-EDIT COMMAND") (TERPRI) (MAPRINT (QUOTE (TO FIND OUT THE
LIST OF KNOWN SUPERATOMS TYPE ←KNOWNSUPERATOMS))) (TERPRI) (TERPRI)
(MAPCAR EDITSTRUCCOMMANDS (FUNCTION (LAMBDA (CC) (PROGN (TERPRI) (PRIN1
CC) (SPACES 2) (PRINT (QUOTE :)) (TERPRI) (PRINT (COND ((GETP CC (QUOTE
EDITSTRUCEXPLAIN))) (T (QUOTE SORRY)))) (TERPRI))))) (TERPRI) (MAPRINT
(QUOTE (TYPING ANY VARIABLE WILL GIVE ITS VALUE))) (TERPRI) (MAPRINT
(QUOTE (SOME OF THE KEY VARIABLES ARE : KNOWNSUPERATOMS 
EDITSTRUCCOMMANDS EDITSTRUCTURE LASTNODE))) (TERPRI) (MAPRINT (QUOTE
(THE FOLLOWING COMMANDS ARE UNDOABLE : CYCLE CHAIN JOIN NAMEIT <NAME
OF ANY KNOWN SUPERATOM> ADDFV SATURATE UNSATURATE))) (TERPRI) (TERPRI)
ELSE (PRINT (COND ((GETP ARG (QUOTE EDITSTRUCEXPLAIN))) (T (QUOTE
SORRY)))) (TERPRI))))

(JOIN
(LAMBDA (N1 N2 STRING STRUC) (SETQ STRUC (COPY (OR STRUC EDITSTRUCTURE)))
(IF (AND (NUMBERP STRING) (NOT (NUMBERP N2))) THEN (SETQ TEMP N2)
(SETQ N2 STRING) (SETQ STRING TEMP)) (COND (STRING (PROG (NEWN1 NEWN2)
(SETQ NEWN1 (ADD1 LASTNODE)) (SETQ STRING (CHAIN STRING)) (SETQ NEWN2
LASTNODE) (CONNECT (FINDCTE N1 STRUC) (FINDCTE NEWN1 STRING)) (CONNECT
(FINDCTE N2 STRUC) (FINDCTE NEWN2 STRING)))) ((AND (NOT (NUMBERP N2))
(ATOM N2)) (SETQ TEMP (ADD1 LASTNODE)) (CHAIN N2) (JOIN N1 TEMP))
((AND (NUMBERP N1) (NUMBERP N2)) (CONNECT (FINDCTE N1 STRUC) (FINDCTE
N2 STRUC))) (T (ERROR "BAD ARGUMENTS TO JOIN"))) (/RPLACA (QUOTE 
EDITSTRUCTURE) STRUC)))

(MERGESTRUCS
(LAMBDA (S1 S2) (SETQ S2 (OR S2 EDITSTRUCTURE)) (STRUCTURE CTABLE
= (APPEND (CTABLE S1) (CTABLE S2)) LASTNODE# = LASTNODE UGRAPH = (QUOTE
EDITSTRUCTURE))))

(NAME
(LAMBDA (IT X) (COND ((NOT X) (SETQ X IT))) (GSET X (STRUCTURE FROM
EDITSTRUCTURE UGRAPH = X)) (COND (KNOWNSUPERATOMS (/SET (QUOTE 
KNOWNSUPERATOMS) (CONS X KNOWNSUPERATOMS))) (T (SETQ KNOWNSUPERATOMS
(LIST X)))) (/NCONC LISPXMACROS (LIST (RECOGNIZEFN* X)))))

(NEWSTRUCTURE
(LAMBDA NIL (SETQ LASTNODE 0) (SETQ EDITSTRUCTURE (STRUCTURE UGRAPH
= (QUOTE NEW-STRUCTURE))) (QUOTE FINE)))

(P
(LAMBDA (XX) (PRINT (COND ((NOT XX) EDITSTRUCTURE) ((ATOM XX) (EVAL
XX)) (T XX)))))

(PUTNEWNODE
(LAMBDA (STRUC) (IF STRUC THEN (PROGN (SETQ LASTNODE (ADD1 (LASTNODE#
STRUC))) (STRUCTURE FROM STRUC CTABLE = (PUTNEWNODEINCT (CTENTRY NODENUM
= LASTNODE) (CTABLE OF STRUC)) LASTNODE# = LASTNODE)) ELSE (PROGN
(SETQ LASTNODE (ADD1 LASTNODE)) (STRUCTURE CTABLE = (LIST (CTENTRY
NODENUM = LASTNODE)) LASTNODE# = LASTNODE)))))

(RECOGNIZEFN
(LAMBDA (SUPAT) (PROG (SS) (SETQ SS (COPY SUPAT)) (RETURN (COND ((EQUAL
EDITSTRUCTURE (QUOTE (STRUCTURE NIL NEW-STRUCTURE NIL NIL))) (/RPLACA
(QUOTE EDITSTRUCTURE) SS) (/RPLACA (QUOTE LASTNODE) (LASTNODE# SS))
(QUOTE (NOW MADE EDITSTRUCTURE))) (T (PROGN (FOR NEW CT IN (CTABLE
OF SS) DO (REPLACE (NODENUM CT) (PLUS (NODENUM CT) LASTNODE)) (REPLACE
(NBRS CT) (FOR NEW N IN (NBRS CT) XLIST (PLUS N LASTNODE)))) (REPLACE
(LASTNODE# SS) (PLUS LASTNODE (LASTNODE# SS))) (/RPLACA (QUOTE LASTNODE)
(LASTNODE# SS)) (/RPLACA (QUOTE EDITSTRUCTURE) (MERGESTRUCS SS)) (QUOTE
(MERGED WITH WHAT YOU ALREADY HAVE)))))))))

(RECOGNIZEFN*
(LAMBDA (SUPAT) (LIST SUPAT (LIST (QUOTE RECOGNIZEFN) SUPAT))))

(REMOVEDOTS
(LAMBDA (NODE NUMBER STRUC) (PROG (M) (SETQ STRUC (OR STRUC 
EDITSTRUCTURE)) (SETQ NUMBER (OR NUMBER 1)) (SETQ M (DOTSFIELD (MARKERS
(FINDCTE NODE STRUC)))) (RPLACD M (DIFFERENCE (CDR M) NUMBER)))))

(SATURATE
(LAMBDA (N1 N2 STRUC) (SETQ STRUC (OR STRUC EDITSTRUCTURE)) (COND
(DOTNOTATION (REMOVEDOTS N1 1 STRUC) (REMOVEDOTS N2 1 STRUC)) (T (
DISCONNECT (FINDCTE N1 STRUC) (FINDCTE N2 STRUC))))))

(SHOWIT
(LAMBDA (FLAG) (COND (FLAG (DRAW (STRUCTURE FROM EDITSTRUCTURE CTABLE
= (MAPCAR (CTABLE EDITSTRUCTURE) (F/L (X) (SETQ X (COPY X)) (REPLACE
(ATOMTYPE (MARKERS X)) (NODENUM X)) X))))) (T (DRAW EDITSTRUCTURE)))
T))

(UNSATURATE
(LAMBDA (N1 N2 STRUC) (SETQ STRUC (OR STRUC EDITSTRUCTURE)) (COND
(DOTNOTATION (ADDDOTS N1 1 STRUC) (ADDDOTS N2 1 STRUC)) (T (CONNECT
(FINDCTE N1 STRUC) (FINDCTE N2 STRUC))))))
)
(DEFLIST(QUOTE(
(DOTSFIELD (DOTS . 0))
))(QUOTE RECDEFAULT))

(/NCONC LISPXMACROS EDITSTRUCMACROS)
(/NCONC LISPXMACROS (MAPCAR KNOWNSUPERATOMS (FUNCTION RECOGNIZEFN)))
STOP